home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGASIC / BASFILES.LZH / QBTXKYSB.BAS < prev    next >
BASIC Source File  |  1988-09-10  |  9KB  |  385 lines
  1. '$INCLUDE:'QBTOOLS.INC'
  2. '' '$INCLUDE: '\include\qbtools2.inc'
  3. '' '$INCLUDE: '\include\qbt2indx.inc'
  4. '' '-------------------------Standard Include Merge Section-------------------
  5.  
  6. DEFSNG A-Z
  7.     SUB KeySelectBox (Ch AS KeySelection, Opt$, IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%) STATIC
  8.     
  9.     CONST CORRUPT = "Error:Internal, KeySelectBox Index Corrupt"
  10.  
  11.         IF Xh%(IxNum%, 2) = 0 THEN                                 '  No keys in the index
  12.             Opt$ = ""
  13.             Mr% = 0
  14.             Sc% = 0
  15.             Ch.Echoice = -1      '  No Keys in the Index
  16.             EXIT SUB
  17.         END IF                                                     ' xh%(IxNum%,2%)=0%
  18.  
  19.         REDIM Dg$(2), d$(10)
  20.         REDIM SvScr%(2000)
  21.  
  22.         Tx% = Ch.Row
  23.         Ty% = Ch.Col
  24.         height% = Ch.Lin
  25.  
  26.         REDIM Disp$(height%), Mrtemp%(height%), Sctemp%(height%)
  27.  
  28.         ExitOp% = Ch.Exi
  29.         d$(1) = Ch.o1
  30.         d$(2) = Ch.o2
  31.         d$(3) = Ch.o3
  32.         d$(4) = Ch.o4
  33.         d$(5) = Ch.o5
  34.         d$(6) = Ch.o6
  35.         d$(7) = Ch.o7
  36.         d$(8) = Ch.o8
  37.         d$(9) = Ch.o9
  38.         d$(10) = Ch.o10
  39.  
  40.         Ex$ = "ESC = Exit  ENTER = Select  ? = Find"
  41.         Dwidth% = Maximum%(Ch.KeyLen, LEN(Ex$))
  42.  
  43.         Dg$(1) = Ch.Init1
  44.         Dg$(2) = Ch.Init2
  45.  
  46.         Trim Dg$(1)
  47.         Trim Dg$(2)
  48.  
  49.         FOR j% = 1 TO 10
  50.             Trim d$(j%)
  51.             Dwidth% = Maximum%(Dwidth%, LEN(d$(j%)))
  52.         NEXT j%
  53.  
  54.         Dwidth2% = Dwidth%
  55.         Dwidth% = Dwidth% + 2
  56.  
  57.         TotalHeight% = height% + 2                                 '  Scroll box height (plus borders)
  58.         TotalHeight% = TotalHeight% + ExitOp% + 2                  '  Quit Box + ESC + Line
  59.  
  60.         CheckHeight% = TotalHeight% + Tx% - 1                      '  Check the complete height
  61.         IF CheckHeight% > 25 THEN
  62.             Opt$ = ""
  63.             Mr% = 0
  64.             Sc% = 0
  65.             EXIT SUB
  66.         END IF
  67.  
  68.         CheckWidth% = Dwidth% + Ty% - 1
  69.  
  70.         IF CheckWith% > 80 THEN
  71.             Opt$ = ""
  72.             Mr% = 0
  73.             Sc% = 0
  74.             EXIT SUB
  75.         END IF
  76.  
  77.         SaveScreen SvScr%(1)
  78.         DrawBox Tx%, Ty%, Dwidth%, TotalHeight%, Ch.Btype, Ch.Ff, Ch.Fb, 1, Ch.Nf, Ch.Nb
  79.         Crow% = Tx% + height% + 1
  80.         Ccol% = Ty% + 1
  81.         Acc$ = STRING$(Dwidth% - 2, 196)
  82.         Att% = Attributes%(Ch.Ff, Ch.Fb, 0, 0)
  83.         Att1% = Attributes%(Ch.Nf, Ch.Nb, 0, 0)
  84.         Att2% = Attributes%(Ch.Sf, Ch.Sb, 0, 0)
  85.         ColorPrint Acc$, Crow%, Ccol%, Att%
  86.  
  87.         Crow% = Tx% + height% + 2
  88.         ColorPrint Ex$, Crow%, Ccol%, Att%
  89.  
  90.         FOR j% = 1 TO Ch.Exi
  91.             Acc$ = d$(j%)
  92.             Crow% = Tx% + height% + j% + 2
  93.             ColorPrint Acc$, Crow%, Ccol%, Att1%
  94.         NEXT j%
  95.  
  96.         GOSUB HomeKeys                                             '  Display from the top
  97.         GOSUB DisplayKeys                                          '  Display the keys
  98.         Curs% = 1                                                  '  Cursor Row
  99.  
  100.         DO                                                         '  Controlling Loop
  101.             Acc$ = Disp$(Curs%)
  102.             IF LEN(Acc$) < Dwidth2% - 2 THEN
  103.                 Acc$ = Acc$ + STRING$(Dwidth2% - LEN(Acc$), 32)
  104.             END IF
  105.             Crow% = Curs% + Tx%
  106.             ColorPrint Acc$, Crow%, Ccol%, Att2%
  107.  
  108.             Kbd$ = ""
  109.             WHILE Kbd$ = ""
  110.                 Kbd$ = INKEY$
  111.             WEND
  112.  
  113.             IF LEN(Kbd$) = 1 THEN
  114.                 Opt% = ASC(Kbd$)
  115.                 SELECT CASE Opt%
  116.                  
  117.                     CASE 63                                           '  ? Question Mark
  118.                         DialogBox Dg$(), 1, 1, Ch.KeyLen, Ch.Ff, Ch.Fb, Ch.Nf, Ch.Nb, 1, Ans$, Exk%
  119.                         ky$ = Ans$
  120.                         IndexFind IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  121.                      
  122.                         IF Sc% THEN
  123.                             Disp$(1) = ky$
  124.                             Mrtemp%(1) = ABS(Mrec%)
  125.                             Sctemp%(1) = Sc%
  126.                         ELSE
  127.                             PRINT CORRUPT
  128.                             END
  129.                         END IF
  130.                      
  131.                         PmRec% = Mrec%
  132.                         GOSUB GetNextTen
  133.                         Curs% = 1
  134.                         GOSUB DisplayKeys
  135.  
  136.                     CASE 27                                           '   Simple ESCAPE
  137.                         ky$ = ""
  138.                         Mrec% = 0
  139.                         Sc% = 0
  140.                         Ch.Echoice = 11                                 '   Flag for ESC
  141.                         EXIT DO
  142.  
  143.                     CASE 13                                           '   RETURN
  144.                         ky$ = Disp$(Curs%)
  145.                         Mrec% = Mrtemp%(Curs%)
  146.                         Sc% = Sctemp%(Curs%)
  147.                         Ch.Echoice = 12                                 '   Flag for RETURN
  148.                         EXIT DO
  149.  
  150.                     CASE ELSE
  151.                 END SELECT
  152.  
  153.             END IF
  154.  
  155.             IF LEN(Kbd$) = 2 THEN
  156.                 Opt% = ASC(RIGHT$(Kbd$, 1))
  157.                 SELECT CASE Opt%
  158.  
  159.                     CASE 59 TO 68
  160.                         Fkey% = Opt% - 58
  161.                         IF Ch.Exi >= Fkey% THEN
  162.                             Ch.Echoice = Fkey%
  163.                             ky$ = Disp$(Curs%)
  164.                             Mrec% = Mrtemp%(Curs%)
  165.                             Sc% = Sctemp%(Curs%)
  166.                             EXIT DO
  167.                         END IF
  168.  
  169.                     CASE 71                                           '  Home
  170.                         Curs% = 1
  171.                         GOSUB HomeKeys
  172.                         GOSUB DisplayKeys
  173.  
  174.  
  175.                     CASE 79                                           '  End
  176.                         GOSUB EndKeys
  177.                         GOSUB DisplayKeys
  178.                         Curs% = height% - top% + 1
  179.  
  180.                     CASE 80                                           '  Down Arrow
  181.                         Curs% = Curs% + 1
  182.                         IF Curs% > height% THEN
  183.                             Curs% = Curs% - 1
  184.  
  185.                             IF Sctemp%(height%) <> 0 THEN
  186.                                 ky$ = Disp$(height%)
  187.                                 Mrec% = Mrtemp%(height%)
  188.                                 Sc% = Sctemp%(height%)
  189.                                 Psc% = Sc%
  190.                                 IndexNext IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  191.  
  192.                                 IF Sc% <> 0 THEN
  193.                                     IF Psc% <> Sc% THEN
  194.                                         FOR j% = 1 TO height% - 1
  195.                                             Sctemp%(j%) = Sctemp%(j% + 1)
  196.                                             Mrtemp%(j%) = Mrtemp%(j% + 1)
  197.                                             Disp$(j%) = Disp$(j% + 1)
  198.                                         NEXT j%
  199.                                         Disp$(height%) = ky$
  200.                                         Mrtemp%(height%) = Mrec%
  201.                                         Sctemp%(height%) = Sc%
  202.                                     END IF
  203.                                 END IF
  204.                             END IF
  205.                         ELSE
  206.                             IF Sctemp%(Curs%) = 0 THEN
  207.                                 Curs% = Curs% - 1
  208.                             END IF
  209.                         END IF
  210.                         GOSUB DisplayKeys
  211.  
  212.                     CASE 72                                           '  Up Arrow
  213.                         Curs% = Curs% - 1
  214.                         IF Curs% < 1 THEN
  215.                             Curs% = Curs% + 1
  216.  
  217.                             IF Sctemp%(1) <> 0 THEN
  218.                                 ky$ = Disp$(1)
  219.                                 Mrec% = Mrtemp%(1)
  220.                                 Sc% = Sctemp%(1)
  221.                                 Psc% = Sc%
  222.                                 IndexPrevious IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  223.  
  224.                                 IF Sc% <> 0 THEN
  225.                                     IF Psc% <> Sc% THEN
  226.                                         FOR j% = height% TO 2 STEP -1
  227.                                             Sctemp%(j%) = Sctemp%(j% - 1)
  228.                                             Mrtemp%(j%) = Mrtemp%(j% - 1)
  229.                                             Disp$(j%) = Disp$(j% - 1)
  230.                                         NEXT j%
  231.                                         Disp$(1) = ky$
  232.                                         Mrtemp%(1) = Mrec%
  233.                                         Sctemp%(1) = Sc%
  234.                                     END IF
  235.                                 END IF
  236.                             END IF
  237.                         ELSE
  238.                             IF Sctemp%(Curs%) = 0 THEN
  239.                                 Curs% = Curs% + 1
  240.                             END IF
  241.                         END IF
  242.                         GOSUB DisplayKeys
  243.  
  244.                     CASE ELSE
  245.                 END SELECT
  246.             END IF
  247.  
  248.         LOOP
  249.  
  250.         RestoreScreen SvScr%(1)
  251.  
  252.  
  253.         EXIT SUB
  254.  
  255. DisplayKeys:
  256.  
  257.         FOR j% = 1 TO height%
  258.             Acc$ = Disp$(j%)
  259.             IF LEN(Acc$) < Dwidth2% THEN
  260.                 Acc$ = Acc$ + STRING$(Dwidth2% - LEN(Acc$), 32)
  261.             END IF
  262.             Crow% = Tx% + j%
  263.             ColorPrint Acc$, Crow%, Ccol%, Att%
  264.         NEXT j%
  265.         RETURN
  266.  
  267. HomeKeys:
  268.  
  269.         FOR j% = 1 TO 2
  270.             Mrtemp%(j%) = 0
  271.             Sctemp%(j%) = 0
  272.             PmRec% = 0
  273.             Disp$(j%) = STRING$(Ch.KeyLen, 32)
  274.         NEXT j%
  275.  
  276.         IndexFindFirst IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  277.         IF Sc% THEN
  278.             Disp$(1) = ky$
  279.             Mrtemp%(1) = Mrec%
  280.             Sctemp%(1) = Sc%
  281.         ELSE
  282.             PRINT CORRUPT
  283.             END
  284.         END IF
  285.  
  286.         PmRec% = Mrec%
  287.         Psc% = Sc%
  288.         Curs% = 1
  289.  
  290. GetNextTen:
  291.         
  292.         FOR j% = 2 TO height%
  293.             Mrtemp%(j%) = 0
  294.             Sctemp%(j%) = 0
  295.             Disp$(j%) = STRING$(Ch.KeyLen, 32)
  296.         NEXT j%
  297.         
  298.         FOR j% = 2 TO height%
  299.             IndexNext IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  300.             IF Sc% > 0 THEN
  301.                 IF PmRec% = Mrec% AND Sc% = Psc% THEN
  302.                     EXIT FOR
  303.                 ELSE
  304.                     Disp$(j%) = ky$
  305.                     Mrtemp%(j%) = Mrec%
  306.                     Sctemp%(j%) = Sc%
  307.                     PmRec% = Mrec%
  308.                     Psc% = Sc%
  309.                 END IF
  310.             ELSE
  311.                 EXIT FOR
  312.             END IF
  313.         NEXT j%
  314.         Ah% = j% - 1   '  Height%
  315.         RETURN
  316.  
  317. EndKeys:
  318.  
  319.         FOR j% = height% TO height%
  320.             Mrtemp%(j%) = 0
  321.             Sctemp%(j%) = 0
  322.             Disp$(j%) = STRING$(Ch.KeyLen, 32)
  323.         NEXT j%
  324.  
  325.         IndexFindLast IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  326.         IF Sc% THEN
  327.             Disp$(height%) = ky$
  328.             Mrtemp%(height%) = Mrec%
  329.             Sctemp%(height%) = Sc%
  330.         ELSE
  331.             PRINT CORRUPT
  332.             END
  333.         END IF
  334.  
  335.         PmRec% = Mrec%
  336.         Psc% = Sc%
  337.         Curs% = 1
  338.  
  339. GetPreviousTen:
  340.         
  341.         FOR j% = 1 TO height% - 1
  342.             Mrtemp%(j%) = 0
  343.             Sctemp%(j%) = 0
  344.             Disp$(j%) = STRING$(Ch.KeyLen, 32)
  345.         NEXT j%
  346.  
  347.         top% = 1
  348.         FOR j% = height% - 1 TO 1 STEP -1
  349.             Disp$(j%) = STRING$(Ch.KeyLen, 32)
  350.             IndexPrevious IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
  351.             IF Sc% > 0 THEN
  352.                 IF Psc% = Sc% AND PmRec% = Mrec% THEN
  353.                     EXIT FOR
  354.                 ELSE
  355.                     Disp$(j%) = ky$
  356.                     Mrtemp%(j%) = Mrec%
  357.                     Sctemp%(j%) = Sc%
  358.                     PmRec% = Mrec%
  359.                     Psc% = Sc%
  360.                 END IF
  361.             ELSE
  362.                 top% = j% + 1
  363.                 EXIT FOR
  364.             END IF
  365.         NEXT j%
  366.  
  367.         IF top% <> 1 THEN
  368.             FOR j% = 1 TO (height% - top%) + 1
  369.                 Disp$(j%) = Disp$(j% + top% - 1)
  370.                 Disp$(j% + top% - 1) = STRING$(Ch.KeyLen, 32)
  371.  
  372.                 Mrtemp%(j%) = Mrtemp%(j% + top% - 1)
  373.                 Mrtemp%(j% + top% - 1) = 0
  374.  
  375.                 Sctemp%(j%) = Sctemp%(j% + top% - 1)
  376.                 Sctemp%(j% + top% - 1) = 0
  377.             NEXT j%
  378.         END IF
  379.  
  380.  
  381.         RETURN
  382.  
  383.     END SUB
  384.  
  385.